; _____ _ __ __ _
; / ____| | | \ \ / / | |
; | | ___ _ __ ___ ___ | | ___ \ \ /\ / /___ _ __ __| |___
; | | / _ \| '_ \/ __|/ _ \| |/ _ \ \ \/ \/ // _ \| '__/ _` / __|
; | |____| (_) | | | \__ \ (_) | | __/ \ /\ /| (_) | | | (_| \__ \
; \_____|\___/|_| |_|___/\___/|_|\___| \/ \/ \___/|_| \__,_|___/
; Console IO words
; BREAK? ( -- )
; scans keyboard and does an ABORT if break (FCTN 4) is pressed
breakh data dfah,6
text 'BREAK?'
break data docol,keyq,lit,2,eq,zbrnch,break1
data cr,toterm,brkmsg,cr,ab0rt
break1 data exit
brkmsg byte 5 ; length of text
text 'Break '
; GOTOXY ( x y -- )
; sets the screen cursor to the specified (0 based) x y screen coordinates
goxyh data breakh,6
text 'GOTOXY'
gotoxy data $+2
mov *stack+,@scry ; pop y
mov *stack+,@scrx ; pop x
b *next
; TYPE addr +n -- M,79
; +n characters are displayed from memory beginning with the character at addr
; and continuing through consecutive addresses.
; Nothing is displayed if +n is zero.
; See: "9.5.4 TYPE"
typeh data goxyh,4
text 'TYPE'
type data $+2
type1 mov *stack+,r13 ; pop length in r13
mov *stack+,r10 ; address in r10
mov r13,r13 ; check the length
jle typout ; if 0 or negative then exit
typlp movb *r10+,r7 ; get byte from string in r7 MSB
swpb r7 ; rotate MSB into LSB
dect stack ; create space on stack
mov r7,*stack ; place on stack
bl @emit_ ; call emit
dec r13 ; have we finished?
jne typlp ; if not, repeat
typout b *next
; WORDS ( -- )
; displays a list of all the words in the dictionary
wordsh data typeh,5
text 'WORDS '
words_ data docol
data cr,lit0,lates_
words1 data fetch,dup,zbrnch,words2
data dup,plus2,dup,fetch,lit,15,and
data swap,plus2,swap,type
words3 data break
words4 data keyq,lit,>ffff,eq,zbrnch,words4
data space1,swap,plus1,swap
data branch,words1
words2 data drop,cr,dot
data toterm,wftxt
data exit
wftxt byte 6
text 'Words '
; XY? ( -- x y )
; places the cursor x and y coordinates on the stack
xyh data wordsh,3
text 'XY? '
xy data $+2
dect stack ; new stack entry
mov @scrX,*stack ; push scrX to stack
dect stack ; new stack entry
mov @scrY,*stack ; push scrY to stack
b *next
; SPACE -- M,79
; Displays an ASCII space.
spaceh data xyh,5
text 'SPACE '
space1 data $+2
dect stack ; new stack entry
li r0,32 ; space character
mov r0,*stack ; push it to stack
bl @emit_ ; call emit
b *next
; SPACES +n -- M,79
; Displays +n ASCII spaces. Nothing is displayed if +n is zero.
spcesh data spaceh,6
text 'SPACES'
spces data $+2
mov *stack+,r7 ; pop count in r7
mov r7,r7 ; check for 0
jeq spcesx ; if zero, just quit
abs r7 ; make positive if negative
spces1 dect stack ; create stack entry
li r8,32 ; space character
mov r8,*stack ; put space on stack
bl @emit_ ; display the space via emit
dec r7 ; decrement count
jne spces1 ; repeat if not finished
spcesx b *next
; PAGE ( -- )
; clears screen
clsh data spcesh,4
text 'PAGE'
cls data $+2
bl @bank1
data _cls ; see 1-02-Console.a99
; JOYST ( joystick# -- value )
; Scans the joystick returning the direction value
joysth data clsh,5
text 'JOYST '
joyst data $+2
bl @bank1 ; see 1-02-Console.a99
data _joyst
; EMIT 16b -- M,83
; The least-significant 8-bit ASCII character is displayed. SEE: "9.5.3 EMIT"
emith data joysth,4
text 'EMIT'
emit data $+2
; EMIT as called from the Forth environment:
bl @emit_ ; call emit routine (see below)
b *next
; emit as an internal assembly sub-routine (used by SPACE, SPACES & TYPE):
emit_ mov r11,r9 ; save return address
bl @ccp ; compute cursor position (loaded into r0)
mov *stack+,r1 ; pop character
swpb r1 ; get byte in msb
bl @vsbw ; write char to screen at computed position
inc @scrX ; increment x postion of cursor
c @scrx,@xmax ; have we hit the right-most column?
jeq clipx ; if yes, reset x
b *r9 ; else return
clipx clr @scrX ; reset x to 0
inc @scrY ; increment y
c @scrY,@ymax ; have we hit the bottom of the screen?
jeq scrlup ; if yes then scroll screen up
b *r9 ; else return
; KEY -- 16b M,83
; The least-significant 7 bits of 16b is the next ASCII character received.
; All valid ASCII characters can be received.
; Control characters are not processed by the system for any editing purpose.
; Characters received by KEY will not be displayed.
; See: "9.5.1 KEY"
nokey equ >ff00 ; keycode for no key pressed
delkey equ 3 ; keycode for delete key
kscnh data emith,3
text 'KEY '
key data $+2
clr @cursrd
bl @kscn ; call key scan routine
b *next ; NEXT
; keyscan has been split from the forth word KEY.
; this allows it to be called both as a forth word (KEY) and as a machine
; code routine.
kscn mov r11,r8 ; save return address
kscn1 bl @cflash ; call cursor flash routine
movb @keydev,@>8374 ; set keyboard to scan
lwpi >83e0 ; use gpl workspace
bl @>000e ; call keyboard scanning routine
; restore the turboforth workspace
; TFs workspace is held in 'wp'. This routine writes a program in the GPL
; workspace starting at R0 which performs an LWPI instruction, and then
; jumps the remainder of this keyscan routine below.
;
li r0,>02e0 ; lwpi instruction
mov @wp,r1 ; lwpi operand
li r2,>0460 ; branch opcode
li r3,kscn2 ; operand for branch instruction
b r0
kscn2 movb @gplst,r7 ; get GPL STATUS byte in r7 MSB
sla r7,3 ; shift COND bit into carry bit
jnc kscn1 ; no key pressed, or same key pressed as
; previous scan. ignore and re-scan.
movb @keyin,r7 ; a new key was pressed: get ascii code in
; r7 msb
ci r7,nokey ; compare against 'no key pressed' code
jeq kscn1 ; no key was pressed
srl r7,8 ; a key was pressed. move to low byte
dect stack ; new stack entry
mov r7,*stack ; place ascii code onto stack
b *r8 ; return to caller
; cursor flashing
cflash mov @bank0,@retbnk ; return to bank 0
limi 2 ; service isr
limi 0
mov r11,r6 ; save return address
li r7,>2000 ; load space & ascii 0 characters for cursor
mov @cursrd,r0 ; get cursor delay
ai r0,>80 ; increment
mov r0,@cursrd ; save it
jeq csrwrt ; if zero, write a blank cursor character
swpb r7 ; load _ cursor character
ci r0,>8000 ; cursror delay = >8000?
jeq csrwrt ; if yes, write an _ cursor character
b *r6 ; if neither, just return
csrwrt bl @ccp ; call compute cursor position
mov r7,r1 ; move cursor character to r1 for VSBW
bl @vsbw ; write the cursror character to the screen
b *r6 ; return to caller
; KEY? ( -- ascii/-1 )
; Scans keyboard and returns the ascii code of the key pressed,
; or -1 if no key pressed
keyqh data kscnh,4
text 'KEY?'
keyq data $+2
bl @keyqsr ; call as subroutine
b *next
keyqsr movb @keydev,@>8374 ; set keyboard to scan
lwpi >83e0 ; use gpl workspace
bl @>000e ; call keyboard scanning routine
lwpi wkspc ; restore to our workspace
movb @keyin,r7 ; a new key was pressed: get ascii code in r7 msb
sra r7,8 ; move to low byte
dect stack ; make space on stack
mov r7,*stack ; place value on stack
mov r12,@>83d6 ; defeat auto screen blanking
rt